home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / eventq.exe / SCRDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-13  |  14KB  |  380 lines
  1. {****************************************************************************}
  2. { This unit demonstrates a method by which one can automate a Turbo Vision   }
  3. { application using the event queue defined in EVENTQ.PAS. It declares a     }
  4. { a descendant of TEventQApp which, in addition to functioning as a near-    }
  5. { equivalent of TApplication, also has the ability to read keystrokes out of }
  6. { a script file. In order to run the demo, you need to make a copy of        }
  7. { TVDEMO.PAS and make the following changes:                                 }
  8. {                                                                            }
  9. {    1) Add 'ScrDemo' to the 'uses' statement.                               }
  10. {    2) Change all occurrences of 'TApplication' to 'TScriptApp' (5 total).  }
  11. {                                                                            }
  12. { After making the changes, compile the modified copy of TVDEMO to disk and  }
  13. { run it from the command line. Be sure that SCRIPT.SCR and SCRDEMO.PAS are  }
  14. { both present in the current directory before you run the demo.             }
  15. {                                                                            }
  16. { This unit is intended to be a demo only. You will probably need to make    }
  17. { changes, unless the only thing you want to do is animate a Turbo Vision    }
  18. { program (as a self-running demo, for example). See SCRIPT.SCR for details  }
  19. { on the syntax of the script language.                                      }
  20. {****************************************************************************}
  21.  
  22. {$X+}
  23. unit ScrDemo;
  24.  
  25. interface
  26.  
  27. uses Dos,Drivers,Objects,MsgBox,EventQ;
  28.  
  29. {****************************************************************************}
  30. { The name of the script file is hard-coded as shown below. For a real       }
  31. { application, you will probably want to make it a parameter passed to Init. }
  32. {****************************************************************************}
  33.  
  34. const
  35.   ScriptFileName: PathStr = ('SCRIPT.SCR');
  36.  
  37. type
  38.   PScript = ^TScript;
  39.   TScript = object (TObject)
  40.     F: Text;
  41.     FileIsOpen: Boolean;
  42.     constructor Init (FileName: PathStr);
  43.     procedure Run (P: PEventQApp);
  44.     destructor Done; virtual;
  45.     end;
  46.  
  47.   PScriptApp = ^TScriptApp;
  48.   TScriptApp = object (TEventQApp)
  49.     Scr: TScript;
  50.     constructor Init;
  51.     procedure Idle; virtual;
  52.     destructor Done; virtual;
  53.     end;
  54.  
  55. implementation
  56.  
  57. const
  58.   WaitTime: LongInt = (0);
  59.   DefaultWaitTime: LongInt = (0);
  60.   WaitStart: LongInt = (0);
  61.   Waiting: Boolean = (False);
  62.  
  63. {****************************************************************************}
  64. { ScanCodes is an array which correlates the ASCII characters with the       }
  65. { keyboard scan codes that would have been generated, had the characters     }
  66. { really come from the keyboard. In some cases, more than one scan code will }
  67. { result in the same character; in such cases, one of the possible scan      }
  68. { codes was arbitrarily chosed for this array.                               }
  69. {****************************************************************************}
  70.  
  71.   ScanCodes: array[#0..#255] of Byte = (
  72.     $79,$1E,$30,$2E,$20,$12,$21,$22,$23,$17,$24,$25,$26,$32,$31,$18,
  73.     $19,$10,$13,$1F,$14,$16,$2F,$11,$2D,$15,$2C,$1A,$2B,$1B,$07,$0C,
  74.     $39,$02,$28,$04,$05,$06,$08,$28,$0A,$0B,$09,$0D,$33,$0C,$34,$35,
  75.     $0B,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$27,$27,$33,$0D,$34,$35,
  76.     $03,$1E,$30,$2E,$20,$12,$21,$22,$23,$17,$24,$25,$26,$32,$31,$18,
  77.     $19,$10,$13,$1F,$14,$16,$2F,$11,$2D,$15,$2C,$1A,$2B,$1B,$07,$0C,
  78.     $29,$1E,$30,$2E,$20,$12,$21,$22,$23,$17,$24,$25,$26,$32,$31,$18,
  79.     $19,$10,$13,$1F,$14,$16,$2F,$11,$2D,$15,$2C,$1A,$2B,$1B,$29,$00,
  80.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  81.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  82.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  83.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  84.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  85.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  86.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  87.     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00);
  88.  
  89. function StripSpaces (S: String): String;
  90.  
  91. begin
  92. while S[1] = ' ' do Delete (S,1,1);
  93. while S[Length (S)] = ' ' do Delete (S,Length (S),1);
  94. StripSpaces := S;
  95. end;
  96.  
  97. function Upper (S: String): String;
  98.  
  99. var
  100.   I: Integer;
  101.  
  102. begin
  103. for I := 1 to Length (S) do S[I] := UpCase (S[I]);
  104. Upper := S;
  105. end; {Upper}
  106.  
  107. {****************************************************************************}
  108. { The huge TranslateKey procedure converts key commands in the script file   }
  109. { into the equivalent Turbo Vision events.                                   }
  110. {****************************************************************************}
  111.  
  112. procedure TranslateKey (S: String; var Event: TEvent);
  113.  
  114. var
  115.   Value,ErrCode: Integer;
  116.  
  117. begin
  118. Event.What := evKeyDown;
  119. if Length (S) = 1 then
  120.   begin
  121.   Event.CharCode := S[1];
  122.   Event.ScanCode := ScanCodes[S[1]];
  123.   end
  124. else if S[1] = '^' then
  125.   begin
  126.   if S[1] = '@' then
  127.     begin
  128.     Event.CharCode := #0;
  129.     Event.ScanCode := ScanCodes[#0];
  130.     end
  131.   else if S[1] in ['A'..'_'] then
  132.     begin
  133.     Event.CharCode := Char (Byte (S[1]) - Byte ('A'));
  134.     Event.ScanCode := ScanCodes[Char (Byte (S[1]) - Byte ('A'))];
  135.     end
  136.   else if S[1] in ['a'..'z'] then
  137.     begin
  138.     Event.CharCode := Char (Byte (S[1]) - Byte ('a'));
  139.     Event.ScanCode := ScanCodes[Char (Byte (S[1]) - Byte ('a'))];
  140.     end
  141.   else Event.What := evNothing;
  142.   end
  143. else if S[1] = '#' then
  144.   begin
  145.   Delete (S,1,1);
  146.   Val (S,Value,ErrCode);
  147.   if (ErrCode = 0) and (Value >= 0) and (Value <= 255) then
  148.     begin
  149.     Event.CharCode := Char (Value);
  150.     Event.ScanCode := ScanCodes[Event.CharCode];
  151.     end
  152.   else Event.What := evNothing;
  153.   end
  154. else if (S[1] in ['K','k']) and (S[2] in ['B','b']) then
  155.   begin
  156.   Delete (S,1,2);
  157.   S := Upper (S);
  158.   if S = 'ALTA' then Event.KeyCode := $1E00
  159.   else if S = 'ALTB' then Event.KeyCode := $3000
  160.   else if S = 'ALTC' then Event.KeyCode := $2E00
  161.   else if S = 'ALTD' then Event.KeyCode := $2000
  162.   else if S = 'ALTE' then Event.KeyCode := $1200
  163.   else if S = 'ALTF' then Event.KeyCode := $2100
  164.   else if S = 'ALTG' then Event.KeyCode := $2200
  165.   else if S = 'ALTH' then Event.KeyCode := $2300
  166.   else if S = 'ALTI' then Event.KeyCode := $1700
  167.   else if S = 'ALTJ' then Event.KeyCode := $2400
  168.   else if S = 'ALTK' then Event.KeyCode := $2500
  169.   else if S = 'ALTL' then Event.KeyCode := $2600
  170.   else if S = 'ALTM' then Event.KeyCode := $3200
  171.   else if S = 'ALTN' then Event.KeyCode := $3100
  172.   else if S = 'ALTO' then Event.KeyCode := $1800
  173.   else if S = 'ALTP' then Event.KeyCode := $1900
  174.   else if S = 'ALTQ' then Event.KeyCode := $1000
  175.   else if S = 'ALTR' then Event.KeyCode := $1300
  176.   else if S = 'ALTS' then Event.KeyCode := $1F00
  177.   else if S = 'ALTT' then Event.KeyCode := $1400
  178.   else if S = 'ALTU' then Event.KeyCode := $1600
  179.   else if S = 'ALTV' then Event.KeyCode := $2F00
  180.   else if S = 'ALTW' then Event.KeyCode := $1100
  181.   else if S = 'ALTX' then Event.KeyCode := $2D00
  182.   else if S = 'ALTY' then Event.KeyCode := $1500
  183.   else if S = 'ALTZ' then Event.KeyCode := $2C00
  184.   else if S = 'ALT1' then Event.KeyCode := $7800
  185.   else if S = 'ALT2' then Event.KeyCode := $7900
  186.   else if S = 'ALT3' then Event.KeyCode := $7A00
  187.   else if S = 'ALT4' then Event.KeyCode := $7B00
  188.   else if S = 'ALT5' then Event.KeyCode := $7C00
  189.   else if S = 'ALT6' then Event.KeyCode := $7D00
  190.   else if S = 'ALT7' then Event.KeyCode := $7E00
  191.   else if S = 'ALT8' then Event.KeyCode := $7F00
  192.   else if S = 'ALT9' then Event.KeyCode := $8000
  193.   else if S = 'ALT0' then Event.KeyCode := $8100
  194.   else if S = 'F1' then Event.KeyCode := $3B00
  195.   else if S = 'F2' then Event.KeyCode := $3C00
  196.   else if S = 'F3' then Event.KeyCode := $3D00
  197.   else if S = 'F4' then Event.KeyCode := $3E00
  198.   else if S = 'F5' then Event.KeyCode := $3F00
  199.   else if S = 'F6' t